home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / C / PRINT.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-24  |  6.0 KB  |  196 lines
  1. /* PRINT.C
  2.  ************************************************************************
  3.  *                                    *
  4.  *        PC Scheme/Geneva 4.00 Borland C code            *
  5.  *                                    *
  6.  * (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7.  * (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8.  *                                    *
  9.  *----------------------------------------------------------------------*
  10.  *                                    *
  11.  *            Print an Atom                    *
  12.  *                                    *
  13.  *----------------------------------------------------------------------*
  14.  *                                    *
  15.  * Created by: John Jensen        Date: 1985            *
  16.  * Revision history:                            *
  17.  * - 2 Oct 87:    modified PRINT-ATOM to recognize special atoms such as    *
  18.  *        #T, #F, etc. (tc)                    *
  19.  * - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  20.  *                                    *
  21.  *                    ``In nomine omnipotentii dei''    *
  22.  ************************************************************************/
  23.  
  24. #include    <stdarg.h>
  25. #include    <stdlib.h>
  26. #include    <stdio.h>
  27. #include    <string.h>
  28. #include    "scheme.h"
  29.  
  30. /************************************************************************/
  31. /* Main Print Driver - zprintf                        */
  32. /*                                     */
  33. /************************************************************************/
  34. void    zprintf(char *fmt, ...)
  35. {
  36.     char        buf[2000], *p;
  37.     va_list        argptr;
  38.  
  39.     va_start(argptr, fmt);
  40.     vsprintf(buf, fmt, argptr);
  41.     va_end(argptr);
  42.  
  43.     /* set the default port address for the I/O operation */
  44.     ssetadr(ADJPAGE(OUT_PAGE), OUT_DISP);
  45.  
  46.     for( p = buf; *p; outchar(*p++) );
  47. }
  48.  
  49. extern char     decpoint;    /* The current decimal point character */
  50. extern int      ccount;
  51.  
  52. /****************************************************************/
  53. /* PRINTATM(pg,ds,offs,c)                    */
  54. /* PRINTATM is used for printing both symbols (and        */
  55. /* strings). The atom to be printed is located at logical page    */
  56. /* PG and displacement DS.  The argument OFFS tells how many    */
  57. /* bytes from the top of the atom begin the characters to be    */
  58. /* printed.  The atom printname will be bracketed with the    */
  59. /* character CH at both ends if necessary.            */
  60. /* ( CH=='|' for symbols, '"' for strings.)            */
  61. /****************************************************************/
  62. void    printatm(unsigned pg, unsigned ds, unsigned offs, char ch)
  63. {
  64.     int        j;
  65.     char        *buf;
  66.     int        len;    /* Length of print name */
  67.     int        strange = 0;    /* Number of strange characters */
  68.  
  69.     /* First stage: Copy pname into buffer, count needed escape    */
  70.     /* characters, and determine whether the pname is "strange".    */
  71.     len = get_word(pg, ds + 1) - offs;
  72.     ds += offs;
  73.     if (!(buf = (char *) malloc(offs = 2 * len + 1)))
  74.         malloc_error("printatm");
  75.     strange = (j = blk2pbuf(pg, ds, buf, len, ch, show & SP_OUTPUT)) & 1;
  76.     j >>= 1;
  77.  
  78.     /* Second stage: If necessary, check for numeric, dot, or    */
  79.     /* #-macro confusion.    */
  80.     if (!strange)
  81.         if ((!strcmp(buf, ".")) || (*buf == '#') && (pg != SPECSYM) || (scannum(buf, 10)))
  82.             strange++;
  83.  
  84.     /* Third stage: Send carriage-return if needed, and print    */
  85.     /* pname of atom, delimited if necessary.    */
  86. stage_3:
  87.     ccount += len;        /* Update character count */
  88.     if (show & SP_SEPARE) {
  89.         wrap(j + (((strange = (strange && (show & SP_OUTPUT))) != 0) ? 2 : 0));
  90.         if (strange)
  91.             givechar(ch);
  92.         gvchars(buf, j);
  93.         if (strange)
  94.             givechar(ch);
  95.     }
  96.     free(buf);
  97. }
  98.  
  99. /****************************************************************/
  100. /* PRINTFLO(f)                            */
  101. /* Given a double-length floating-point number, this        */
  102. /* procedure formats and prints the ASCII representation of    */
  103. /* the number.                            */
  104. /****************************************************************/
  105. void    printflo(double f)
  106. {
  107.     char        buf[32];
  108.     printstr(buf, makeflo(f, (BIGDATA *) buf, 0, outrange(f)));
  109. }
  110.  
  111. /****************************************************************/
  112. /* OUTRANGE(f)                            */
  113. /* Returns a non-zero value if the value of the given        */
  114. /* flonum F is not "close" to 1, zero otherwise.        */
  115. /****************************************************************/
  116. int    outrange(double f)
  117. {
  118.     if (f < 0)
  119.         f = -f;
  120.     return    (f < 1.0e-3) || (f >= 1.0e7);
  121. }
  122.  
  123. /****************************************************************/
  124. /* MAKEFLO(flo,buf,prec,ex)                    */
  125. /* Takes a flonum FLO and converts it to a human-readable     */
  126. /* form, storing the characters in the buffer BUF. PREC        */
  127. /* specifies the number of decimal places to be used (as many    */
  128. /* as necessary, up to a maximum, if PREC is 0) and EX        */
  129. /* specifies whether to use exponential (if nonzero) or fixed-    */
  130. /* decimal format.  MAKEFLO returns the number of characters    */
  131. /* placed in BUF, and BUF should be at least 32 bytes.        */
  132. /****************************************************************/
  133. int    makeflo(double flo, BIGDATA *buf, int prec, int ex)
  134. {
  135.     char    digits[32];
  136.     int    scl = 0;
  137.     if (flo == 0.0) {
  138.         *digits = '0';
  139.         ex = 0;
  140.     } else {
  141.         scale(&flo, &scl);
  142.         flo2big(flo * 1.0e15, buf);
  143.         big2asc(buf, digits);
  144.     }
  145.     return    formflo(digits, buf, scl, prec, ex);
  146. }
  147.  
  148. /****************************************************************/
  149. /* SCALE(&flo,&x)                        */
  150. /* Given a pointer FLO to a double-length flonum and a        */
  151. /* pointer X to an integer, SCALE puts at those two locations    */
  152. /* a new flonum and integer such that FLO equals the new    */
  153. /* flonum times 10 to the integer's power and the new flonum    */
  154. /* is in the interval [ 1.0, 10.0 ).                */
  155. /****************************************************************/
  156. void    scale(double *flo, int *x)
  157. {
  158.     double        local;
  159.     double        squar = 10.0;
  160.     double        tensquar[9];
  161.     int        scale, wassmall, i;
  162.  
  163.     scale = wassmall = i = 0;
  164.     local = ((*flo > 0) ? *flo : -*flo);
  165.     if (local == 0)
  166.         *x = 0;
  167.     else {
  168.         if (local < 1.0) {
  169.             wassmall = -1;
  170.             local = 1.0 / local;
  171.         }
  172.         tensquar[0] = 10.0;
  173.         while (++i < 9) {
  174.             squar *= squar;
  175.             tensquar[i] = squar;
  176.         }
  177.         while (--i >= 0) {
  178.             scale <<= 1;
  179.             if (local >= tensquar[i]) {
  180.                 local /= tensquar[i];
  181.                 scale++;
  182.             }
  183.         }
  184.         if (wassmall) {
  185.             scale = -scale;
  186.             local = 1.0 / local;
  187.             if (local != 1.0) {
  188.                 local *= 10;
  189.                 scale--;
  190.             }
  191.         }
  192.         *x = scale;
  193.         *flo = ((*flo < 0.0) ? -local : local);
  194.     }
  195. }
  196.